home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / printer2.pas < prev    next >
Pascal/Delphi Source File  |  1989-10-11  |  6KB  |  150 lines
  1. {      This Unit is a replacement for the Printer unit that   }
  2. { came with Turbo Pascal Version 4.0. Its purpose is twofold. }
  3. { It will allow a user to change the printer port that the    }
  4. { LST file is writing to on the fly.  This takes the place of }
  5. { LstOutPtr and the routine on page 369 of the Turbo Pascal   }
  6. { Version 3.0 manual. The second purpose of this unit is that }
  7. { it will also circumvent DOS's stripping of a Ctrl-Z ($1A,   }
  8. { the End Of File character) when writing to the printer as   }
  9. { an ASCII device.  Ctrl-Z was usually sent as part of a      }
  10. { graphics string to a printer.  In version 3.0 of Turbo      }
  11. { Pascal, an ASCII device is opened in binary mode.  In       }
  12. { version 4.0, an ASCII device is opened in ASCII mode and    }
  13. { DOS thus strips a Ctrl-Z.                                   }
  14. {                                                             }
  15. {      This also provides a good example of a Text file       }
  16. { device driver.                                              }
  17. {                                                             }
  18. { The following example routines are public domain programs   }
  19. { that have been uploaded to our Forum on CompuServe.  As a   }
  20. { courtesy to our users that do not have immediate access to  }
  21. { CompuServe, Technical Support distributes these routines    }
  22. { free of charge.                                             }
  23. {                                                             }
  24. { However, because these routines are public domain programs, }
  25. { not developed by Borland International, we are unable to    }
  26. { provide any technical support or assistance using these     }
  27. { routines.  If you need assistance using these routines, or  }
  28. { are experiencing difficulties, we recommend that you log    }
  29. { onto CompuServe and request assistance from the Forum       }
  30. { members that developed these routines.                      }
  31. {                                                             }
  32. {      Type this to a file called PRINTER2.PAS                }
  33.  
  34. Unit Printer2;
  35.  
  36. Interface
  37.  
  38. Uses DOS;                                  { for using INTR() }
  39.  
  40. Var
  41.   LST : Text;                      { Public LST file variable }
  42.  
  43. Procedure SetPrinter( Port:Byte );
  44. {      SetPrinter sets the printer number to Port where Port  }
  45. { is 'n' in 'LPTn'.  ie.  To write to LPT1: SetPrinter(1),    }
  46. { for LPT2: SetPrinter(2).  SetPrinter changes the Port that  }
  47. { subsequent Write operations will write to.  This lets you   }
  48. { change the printer that you are printing to on the fly.     }
  49.  
  50. Implementation
  51.  
  52. {      The following routines MUST be FAR calls because they  }
  53. { are called by the Read and Write routines.  (They are not   }
  54. { Public (in the implementation section) because they should  }
  55. { only be accessed by the Read and Write routines.)           }
  56.  
  57. {$F+}
  58.  
  59. {      LSTNoFunction performs a NUL operation for a Reset or  }
  60. { Rewrite on LST (just in case).                              }
  61.  
  62. Function LSTNoFunction( Var F: TextRec ): integer;
  63. Begin
  64.   LSTNoFunction := 0;                    { No error           }
  65. end;
  66.  
  67. {      LSTOutputToPrinter sends the output to the Printer     }
  68. { port number stored in the first byte or the UserData area   }
  69. { of the Text Record.                                         }
  70.  
  71. Function LSTOutputToPrinter( Var F: TextRec ): integer;
  72. var
  73.   Regs: Registers;
  74.   P : word;
  75. begin
  76.   With F do
  77.   Begin
  78.     P := 0;
  79.     Regs.AH := 16;
  80.     While (P < BufPos) and ((regs.ah and 16) = 16) do
  81.     Begin
  82.       Regs.AL := Ord(BufPtr^[P]);
  83.       Regs.AH := 0;
  84.       Regs.DX := UserData[1];
  85.       Intr($17,Regs);
  86.       Inc(P);
  87.     end;
  88.     BufPos := 0;
  89.   End;
  90.   if (Regs.AH and 16) = 16 then
  91.     LSTOutputToPrinter := 0              { No error           }
  92.    else
  93.      if (Regs.AH and 32 ) = 32 then
  94.        LSTOutputToPrinter := 159         { Out of Paper       }
  95.    else
  96.        LSTOutputToPrinter := 160;        { Device write Fault }
  97. End;
  98.  
  99. {$F-}
  100.  
  101. {      AssignLST both sets up the LST text file record as     }
  102. { would ASSIGN, and initializes it as would a RESET.  It also }
  103. { stores the Port number in the first Byte of the UserData    }
  104. { area.                                                       }
  105.  
  106. Procedure AssignLST( Port:Byte );
  107. Begin
  108.   With TextRec(LST) do
  109.     begin
  110.       Handle      := $FFF0;
  111.       Mode        := fmOutput;
  112.       BufSize     := SizeOf(Buffer);
  113.       BufPtr      := @Buffer;
  114.       BufPos      := 0;
  115.       OpenFunc    := @LSTNoFunction;
  116.       InOutFunc   := @LSTOutputToPrinter;
  117.       FlushFunc   := @LSTOutputToPrinter;
  118.       CloseFunc   := @LSTOutputToPrinter;
  119.       UserData[1] := Port - 1;  { We subtract one because }
  120.   end;                          { DOS Counts from zero.   }
  121. end;
  122.  
  123.  
  124. Procedure SetPrinter( Port:Byte ); { Documented above     }
  125. Begin
  126.   With TextRec(LST) do
  127.     UserData[1] := Port - 1;{ We subtract one because DOS }
  128. End;                        { Counts from zero.           }
  129.  
  130. Begin  { Initialization }
  131.   AssignLST( 1 );           { Call assignLST so it works  }
  132. end.                        { like Turbo's Printer unit   }
  133.  
  134.  
  135.  
  136. ************ Type this to a Second file ************
  137.  
  138. Program Test_Printer2_Unit;
  139.  
  140. Uses Printer2;
  141.  
  142. Begin
  143.   Writeln(     'Testing...');
  144.   Writeln( LST,'Testing...Printer #1');
  145.   SetPrinter( 1 );
  146.   Writeln( LST,'Testing...Same Printer');
  147.   SetPrinter( 2 );
  148.   Writeln( LST,'Testing...Printer #2');
  149. End.
  150.